home *** CD-ROM | disk | FTP | other *** search
/ Gigantic Games 2 / Gigantic Games 2.iso / pc / _a_ / abitur / txt / abiturscreen.mod < prev    next >
Text File  |  1994-12-23  |  6KB  |  247 lines
  1. IMPLEMENTATION MODULE AbiturScreen;
  2.  
  3.  
  4. FROM Intuition  IMPORT NewScreen, OpenScreen, CloseScreen,
  5.                        NewWindow, OpenWindow, CloseWindow,
  6.                        ViewPortAddress, WindowPtr,
  7.                        IDCMPFlags, IDCMPFlagSet,
  8.                        WindowFlagSet, WindowFlags,
  9.                        ScreenFlagSet, ScreenFlags, customScreen,
  10.                        IntuiMessage, IntuiMessagePtr;
  11. FROM Arts       IMPORT TermProcedure, Assert, BreakPoint;
  12. FROM SYSTEM     IMPORT ADR, ADDRESS;
  13. FROM Exec       IMPORT WaitPort, GetMsg, ReplyMsg;
  14. FROM Graphics   IMPORT SetRGB4, SetAPen, Move, ClearScreen, RectFill,
  15.                        RastPortPtr, ViewModeSet, Text;
  16. FROM Str        IMPORT Length, Copy;
  17.  
  18.  
  19. PROCEDURE CloseAtEnd;
  20. BEGIN
  21.    (* BreakPoint(ADR("AbiScr. CloseAtEnd")); *)
  22.    IF BACKWindow # NIL THEN
  23.       CloseWindow(BACKWindow);
  24.       BACKWindow := NIL
  25.    END;
  26.    IF BACKScreen # NIL THEN
  27.       CloseScreen(BACKScreen);
  28.       BACKScreen := NIL
  29.    END
  30. END CloseAtEnd;
  31.  
  32.  
  33.  
  34.  
  35.  
  36. PROCEDURE OpenTextWindow(Breite, Hoehe: INTEGER): WindowPtr;
  37. VAR TmpNewWindow: NewWindow;
  38.     TmpWPtr: WindowPtr;
  39. (* Öffne ein Fenster zum Beispiel zur TextAusgabe,
  40.  * Zur Ausgabe von Informationen über einen Spieler,
  41.  * Zur Ausgabe von Help-Files, Spielregeln etc.
  42.  *)
  43. BEGIN (* OpenTextWindow *)
  44.    WITH TmpNewWindow DO
  45.       leftEdge := 10;
  46.       topEdge := 12;
  47.       width := Breite;
  48.       height := Hoehe;
  49.       detailPen := 0;
  50.       blockPen := 1;
  51.       idcmpFlags := IDCMPFlagSet{closeWindow, mouseButtons, vanillaKey,
  52.                                  inactiveWindow};
  53.       flags := WindowFlagSet{windowDrag, windowClose,
  54.                              activate, noCareRefresh};
  55.       firstGadget := NIL;
  56.       checkMark := NIL;
  57.       title := NIL;
  58.       screen := BACKScreen;
  59.       bitMap := NIL;
  60.       minWidth := 0; maxWidth := 320;
  61.       minHeight := 0; maxHeight := 256;
  62.       type := customScreen
  63.    END;
  64.    TmpWPtr := OpenWindow(TmpNewWindow);
  65.    Assert(TmpWPtr#NIL, ADR("Window Problem"));
  66.    SetAPen(TmpWPtr^.rPort, 1);
  67.    RETURN TmpWPtr
  68. END OpenTextWindow;
  69.  
  70.  
  71.  
  72. PROCEDURE WaitCloseGadget(W: WindowPtr);
  73. VAR im: IntuiMessagePtr;
  74. BEGIN
  75.    IF W # NIL THEN
  76.       WaitPort(W^.userPort);
  77.       im := GetMsg(W^.userPort);
  78.       ReplyMsg(im);
  79.       CloseWindow(W)
  80.    END (* WHIlE *)
  81. END WaitCloseGadget;
  82.  
  83.  
  84.  
  85. TYPE NormalString = ARRAY[0..50] OF CHAR;
  86.  
  87. VAR AbiText: ARRAY[0..30] OF NormalString;
  88.     NextLine: INTEGER;
  89.  
  90.  
  91. PROCEDURE ClearAbiTxt;
  92. VAR i : INTEGER;
  93. BEGIN
  94.    FOR i := 0 TO 30 DO
  95.       AbiText[i][0] := 0C
  96.    END;
  97.    NextLine := 0;
  98. END ClearAbiTxt;
  99.  
  100.  
  101. PROCEDURE AddAbiTxtLin(Str: ARRAY OF CHAR);
  102. (* Fügt eine Textzeile an, die mit ShowAbiTxt gezeigt werden kann. *)
  103. BEGIN
  104.    Copy(AbiText[NextLine], Str);
  105.    INC(NextLine)
  106. END AddAbiTxtLin;
  107.  
  108.  
  109. PROCEDURE ShowAbiTxt(Col: INTEGER);
  110. (* Zeichnet alle Zeilen, die mit AddAbiTxtLin angefügt wurden.*)
  111. VAR W: WindowPtr;
  112.     l, Longest: INTEGER;
  113.     i: INTEGER;
  114. BEGIN
  115.    IF NextLine = 0 THEN RETURN END;
  116.    Longest := 0;
  117.    FOR i := 0 TO NextLine - 1 DO
  118.       l := Length(AbiText[i]);
  119.       IF l > Longest THEN
  120.          Longest := l
  121.       END
  122.    END;
  123.    W := OpenTextWindow(Longest * 8 + 12, NextLine * 11 + 13);
  124.    SetAPen(W^.rPort, Col);
  125.    FOR i := 0 TO NextLine - 1 DO
  126.       Move(W^.rPort, 6, i * 11 + 19);
  127.       Text(W^.rPort, ADR(AbiText[i]), Length(AbiText[i]))
  128.    END;
  129.    WaitCloseGadget(W);
  130.    ClearAbiTxt
  131. END ShowAbiTxt;
  132.  
  133.  
  134.  
  135.  
  136. VAR RP: RastPortPtr; (* Der RPort des BACKWindows *)
  137.  
  138. PROCEDURE TafelPutz;
  139. BEGIN
  140.    SetAPen (RP, weisS);
  141.    RectFill(RP, 3, 15, 317, 116);
  142.    SetAPen (RP, schwarZ);
  143.    RectFill(RP, 4, 16, 316, 115);
  144.    SetAPen (RP, dgraU);
  145.    RectFill(RP, 159, 15, 160, 116);
  146.  
  147.   (* Kreiden Fach *)
  148.    SetAPen (RP, schwarZ);
  149.    RectFill(RP, 289, 116, 312, 126);
  150.    SetAPen (RP, dgraU);
  151.    RectFill(RP, 290, 117, 311, 125);
  152.    SetAPen (RP, roT);
  153.    RectFill(RP, 292, 115, 293, 116);
  154.    SetAPen (RP, blaU);
  155.    RectFill(RP, 295, 116, 296, 117);
  156.    SetAPen (RP, gelB);
  157.    RectFill(RP, 300, 114, 301, 115);
  158. END TafelPutz;
  159.  
  160.  
  161. (*** HauptProgramm **)
  162.  
  163.  
  164.  
  165. VAR MyNewScreen: NewScreen;
  166. VAR MyNewWindow: NewWindow;
  167.  
  168.  
  169. BEGIN
  170.    BACKScreen := NIL;
  171.    BACKWindow := NIL;
  172.    TermProcedure(CloseAtEnd);
  173.    ClearAbiTxt;
  174.  
  175.    WITH MyNewScreen DO
  176.       leftEdge := 0;
  177.       topEdge := 0;
  178.       width := 320;
  179.       height := 256; (* Eventuell Maximal mögliche ScreenHoehe *)
  180.       depth := 3;
  181.       detailPen := 0;
  182.       blockPen := 1;
  183.       viewModes := ViewModeSet{}; (* Normal kein HAM, extrahalfb. etc. *)
  184.       type := customScreen;       (* sollte gut sein ??? *)
  185.       font := NIL;
  186.       defaultTitle := ADR(" S c h u l s t r e ß ");
  187.       gadgets := NIL;
  188.       customBitMap := NIL
  189.    END;
  190.    BACKScreen := OpenScreen(MyNewScreen);
  191.    Assert(BACKScreen#NIL, ADR("Screen Problem"));
  192.  
  193.    WITH MyNewWindow DO
  194.       leftEdge := 0;
  195.       topEdge := 0;
  196.       width := 320;
  197.       height := 256; (* Eventuell Maximal mögliche WindowHoehe *)
  198.       detailPen := 0;
  199.       blockPen := 1;
  200.       idcmpFlags := IDCMPFlagSet{menuPick, gadgetUp};
  201.       flags := WindowFlagSet{backDrop, borderless, noCareRefresh, activate};
  202.       firstGadget := NIL;
  203.       checkMark := NIL;
  204.       title := NIL (* ADR("") *); (* Geht, da ("") hier global ist. *)
  205.       screen := BACKScreen;
  206.       bitMap := NIL;
  207.       minWidth := 320; maxWidth := 320;
  208.       minHeight := 256; maxHeight := 256;
  209.       type := customScreen
  210.    END;
  211.    BACKWindow := OpenWindow(MyNewWindow);
  212.    Assert(BACKWindow#NIL, ADR("Window Problem"));
  213.  
  214.    SetRGB4(ViewPortAddress(BACKWindow), schwarZ,  0,  0,  0);
  215.    SetRGB4(ViewPortAddress(BACKWindow), weisS  , 15, 15, 15);
  216.    SetRGB4(ViewPortAddress(BACKWindow), hgraU  , 11, 11, 11);
  217.    SetRGB4(ViewPortAddress(BACKWindow), dgraU  ,  8,  8,  8);
  218.    SetRGB4(ViewPortAddress(BACKWindow), roT    , 15,  0,  0);
  219.    SetRGB4(ViewPortAddress(BACKWindow), grueN  ,  0, 15,  0);
  220.    SetRGB4(ViewPortAddress(BACKWindow), blaU   ,  0, 10, 15);
  221.    SetRGB4(ViewPortAddress(BACKWindow), gelB   , 15, 15,  0);
  222.  
  223.  
  224.  
  225.    RP := BACKWindow^.rPort;
  226.  
  227.   (* Hintergrund grau *)
  228.  
  229.    SetAPen (RP, hgraU);
  230.    RectFill(RP, 0,0,320, 256);
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.   (* Tafel *)
  238.    TafelPutz;
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245. END AbiturScreen.
  246.  
  247.